home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 5
/
Aminet 5 - March 1995.iso
/
Aminet
/
util
/
rexx
/
smacros.lha
/
FWMacros
/
Create_Table.arexx
< prev
next >
Wrap
Text File
|
1994-12-17
|
5KB
|
172 lines
/* Create_Table
A Macro by Steven. R. Giovenella, 5823 Dutchess Dr., Colorado Springs, CO 80918.
© Copyright 1994 Steven. R. Giovenella, All rights reserved.
This macro is my gift to the Amiga community. It may be given away free to
anyone, but it may NOT be sold in any way, shape, or form, not even for the cost of
reproduction, downloading, shipping, or handling, without express written
permission from the author listed above. Any person or company who violates the
content of the previous sentence, agrees to pay Steven R. Giovenella $1,000 (US) for
each copy of this macro sold. This macro may NOT be added to any disk which is to
be sold for any price or fee, to include shipping and handling. The ONLY way this
macro may be distributed is on a disk which is given away 100% free of all charges,
or on via telecommunications networks which do not charge any additional fee as a
result of a user downloading this particular macro. This macro may only be
reproduced in its entirety, including all comment lines and code. The individual
user may alter this macro for personal use, but may not then distribute the macro
in any modified form. If you wish, feel free to send me some cash, a Christmas card,
some other piece of software, or absolutely nothing as a gift for creating this macro.
The author of this software is not responsible for any data loss or damage to
computer equipment as a result, direct or indirect, of the use of this macro. */
Options results
/* Warning */
Showmessage 2 0 '" ** WARNING **" " This Macro will
alter the current document." "Unless the document is empty, save before proceed
ing." " Proceed " " Save now " " Quit "'
IF Result = 2 THEN SaveAs
IF Result = 3 THEN Exit
/* Initialize */
Endline = 0
offset = 0
tabpos = 0
/* Establish Uniform Leading */
Status FontSize
Sz = Result
NewLeading = trunc( Sz * 1.25 )
Leading NewLeading
Spacing Variable
/* Box/Line Settings */
ShowMessage 3 0 '"Enter Exterior line weight..." "" "" ".5 pt" "1 pt" "2 pt"'
IF Result = 1 THEN BoxPrefs LINEWT .5
IF Result = 2 THEN BoxPrefs LINEWT 1
IF Result = 3 THEN BoxPrefs LINEWT 2
ShowMessage 3 0 '"Enter Interior line weight..." "" "" "Hair" ".5 pt" "1 pt"'
IF Result = 1 THEN LinePrefs LINEWT Hairline
IF Result = 2 THEN LinePrefs LINEWT .5
IF Result = 3 THEN LinePrefs LINEWT 1
BoxPrefs TEXTFLOW None FILL Transparent
LinePrefs TEXTFLOW None
/* Get page # of insertion point*/
Status Page "Insert"
pagenum = Result
/* Store current begline and endline */
Status LinePos
Coords = Result
PARSE VAR Coords BegLine BegPos EndLine EndPos
IF ( EndLine = "" ) THEN Exit
/* View to 400% */
View 400
/* Move to end of document */
MoveToLine 1000000 1000000
/* Insert a page break */
InsertPageBreak
/* Movetoline begline */
MoveToLine BegLine 0
/* Get scroll position in inches */
Status ScrollPos
Coords = Result
PARSE VAR Coords x top
/* Draw table */
Status LineHeight
lh = Result
heightblock = ( EndLine - BegLine + 1 ) * lh
top = top - (lh * .04)
GetSectionSetup INSIDE OUTSIDE
coords = Result
PARSE VAR Coords inside outside
GetPageSetup Width Orient
coords = Result
PARSE VAR Coords widthright orient
/* Figure Orientation */
width = widthright - outside - inside
DrawBox 1 inside top width heightblock
FirstObj = Result
View 100
/* Ask how many vertical sections */
RequestText '"Create Table" "How many vertical sections?" ""'
Verticals = Result
ShowMessage 1 0 '" Would you like a title block?" "(no vertical dividers in top row)"
"" "Yes"
"Yes - Shaded" "No"'
Title = Result
If ( Title = 1 ) THEN DO
offset = lh
Begline = Begline + 1
DrawBox 1 inside top width lh
END
If ( Title = 2 ) THEN DO
BoxPrefs FILL Solid FILLCOLOR Yellow
offset = lh
Begline = BegLine + 1
DrawBox 1 inside top width lh
END
/* Draw vertical sections */
VertSec = width / Verticals
Leftpos = inside + VertSec
bottom = top + heightblock
limit = Verticals - 1
top = top + offset
DO i = 1 to limit
DrawLine 1 Leftpos top Leftpos bottom
Leftpos = Leftpos +VertSec
END
/* Draw horizontal sections */
top = top + lh
DO i = 1 to ( EndLine - BegLine )
DrawLine 1 inside top (widthright - outside) top
LastObj = Result
top = top + lh
End
/* Insert initial tabs */
DO i = 1 to ( EndLine - BegLine + 1 )
MoveToLine ( BegLine + i - 1 ) 0
type " "
END
MoveToLine 1000000 1000000
Backspace
MoveToLine BegLine 0
FindCursor
ShiftDown
MoveToLine EndLine 1
ShiftUp
/* Align tab positions */
tabpos = VertSec / 2
DO i = 1 to Verticals
Settab tabpos Center
tabpos = tabpos + VertSec
END
IF Title ~= 3 THEN DO
MoveToLine ( Begline - 1 ) 0
Justify Center
MoveToLine ( BegLine - 1 ) 0
END
/* Group Table */
DO i = FirstObj to LastObj
SelectObject i Multiple
END
Group
SelectObject
MovetoLine EndLine 1000000
redraw